Commodore Disk UserVolume 4 #7

home *** CD-ROM | disk | FTP | other *** search

/ Commodore Disk UserVolume 4 #7 / Commodore_Disk_User_Vol.4_7_1991_-.d64 / m_c 64-tel (.txt) < prev next >

Wrap

Commodore BASIC | 1991-01-01 | 12.0 KB | 717 lines

1000 ! this is the code for 64-tel 1010 ! that mimics teletext through 1020 ! the use of the disk drive 1030 ! 1040 *=$9000,$6000 1050 ! 1060 ! initialise 1070 lda #15 ! open ext. sound 1080 sta $d418 ! and set up 'beep' 1090 lda #100 1100 sta $d400 1110 sta $d401 1120 lda #0 1130 sta $d405 1140 lda #240 1150 sta $d406 1160 lda #$20 1170 sta $d404 1180 lda #$80 ! auto repeat 1190 sta 650 1200 jsr $e544 ! clear screen 1210 lda #0 1220 sta $d020 1230 sta $d021 1240 lda #<title ! display title 1250 ldy #>title 1260 jsr $ab1e 1270 ldx #5 ! date & time input 1280 stx di 1290 dat lda di 1300 asl a 1310 tax 1320 lda adt,x ! address table 1330 ldy adt+1,x 1340 jsr $ab1e ! print message 1350 jsr ino ! get number input 1360 php 1370 pha 1380 lda #<cl 1390 ldy #>cl 1400 jsr $ab1e 1410 pla 1420 plp 1430 bcc dt2 1440 jmp dat 1450 bdc clc ! binary to dec conv. 1460 sed 1470 lda #0 1480 bd1 adc #1 1490 dey 1500 bne bd1 1510 cld 1520 rts 1530 dt2 ldx di 1540 sta dtt,x ! date & time table 1550 ldy #152 1560 dd1 dex ! delay 1570 bne dd1 1580 dey 1590 bne dd1 1600 dec di 1610 bpl dat 1620 ldx #5 ! set up clock 1630 dt3 lda #0 1640 ldy dtt,x 1650 beq dt5 1660 jsr bdc ! bin > dec conv. 1670 dt5 sta $dc06,x 1680 dex 1690 cpx #2 1700 bne dt3 1710 lda #0 1720 sta $dc08 1730 lda $dc08 1740 sei 1750 lda #$7f ! kill timer irq 1760 sta $dc0d 1770 sta $dd0d 1780 lda #<irq ! set up raster int. 1790 sta $314 1800 lda #>irq 1810 sta $315 1820 lda #$81 1830 sta $d01a 1840 lda #57 1850 sta $d012 1860 lda $d011 1870 and #$7f 1880 sta $d011 1890 cli 1900 jmp main ! to main prog. 1910 ino jsr gen ! get a digit no. 1920 sta ten ! tens 1930 jsr gen 1940 sta un ! units 1950 jsr evn ! evalute no. 1960 ldx di 1970 sec 1980 cmp lmu,x ! upper no. limit 1990 bcs in1 2000 cmp lml,x 2010 bcs in2 2020 sec 2030 in1 rts 2040 in2 clc 2050 jmp in1 2060 gend jsr $ffe4 ! slightly differ 2070 cmp #$30 2080 bmi gend 2090 cmp #$3a 2100 bpl gend 2110 pha 2120 jmp cgen ! continue 2130 gen jsr $ffe4 ! get a keypress 2140 cmp #$30 2150 bmi gen 2160 cmp #$3a ! was it 0 - 9 ? 2170 bpl gen 2180 pha 2190 jsr $e716 2200 cgen lda #$21 ! sound 'beep' 2210 sta $d404 2220 ldy #20 2230 gn1 dex 2240 bne gn1 2250 dey 2260 bne gn1 2270 lda #$20 2280 sta $d404 2290 pla 2300 sbc #$2f ! asc to real value 2310 rts 2320 evn lda un 2330 ldx ten 2340 beq ev2 2350 clc 2360 ev adc #10 2370 dex 2380 bne ev 2390 ev2 rts 2400 title byt 13,142 2410 byt "[156]welcome to ...",13 2420 byt " [166][166][166] [166] [166] [158] tel ",13 2430 byt " [166] [166] [166] ",13 2440 byt " [166][166][166][166] [166] [166] [213][201] tel ",13 2450 byt " [166] [166] [166][166][166][166][166][166] [202][203] ",13 2460 byt " [166] [166] [166] [158] tel ",13 2470 byt " [166][166][166] [166] ",13,0 2480 cl byt "[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]",0 2490 tl byt "[147]",14,"[158]p100 64-tel 23 jan '90 [158]00:00:00 [156] [146]",0 2500 mon byt "janfebmaraprmayjunjulaugsepoctnovdec" 2510 m0 byt " enter date (01-31) : [157][157]",0 2520 m1 byt " enter month (01-12) : [157][157]",0 2530 m2 byt " enter year (90-99) : [157][157]",0 2540 m3 byt " time seconds (00-59): [157][157]",0 2550 m4 byt " time minutes (00-59): [157][157]",0 2560 m5 byt " time hours (01-12) : [157][157]",0 2570 di byt 0 2580 cp byt 0 2590 ten byt 0 2600 un byt 0 2610 lmu byt 32,13,100,60,60,13 2620 lml byt 1,1,90,0,0,1 2630 adt wor m0,m1,m2,m3,m4,m5 2640 dtt byt 0,0,0,0,0,0 2650 bam byt 66 2660 index byt 100 2670 ! 2680 irq lda $d019 2690 sta $d019 2700 jmp ir2 2710 ire pla 2720 tay 2730 pla 2740 tax 2750 pla 2760 rti 2770 ir2 lda irt ! irq toggle 2780 eor #1 2790 sta irt 2800 tax 2810 lda $d018 ! which screen 2820 and #15 2830 ora wcs,x 2840 sta $d018 2850 lda irl,x ! next ras. line 2860 sta $d012 2870 ldy #31 2880 srp dey ! slight raster pause 2890 bne srp 2900 lda irc,x ! screen col? 2910 sta $d021 2920 dex 2930 bne ir3 2940 jmp $ea31 2950 ir3 lda $7e9 ! flash mode ? 2960 bne ir5 ! yes 2970 ldx ro 2980 bne irr 2990 lda #$10 3000 jmp irr2 3010 irr lda #$20 3020 irr2 sta wcs+1 3030 jmp ir4 3040 ir5 dec fr ! flash rate 3050 beq ir6 3060 jmp ir4 3070 ir6 lda #50 3080 sta fr 3090 lda wcs+1 3100 eor #$30 3110 sta wcs+1 ! toggle 3120 jmp ir4 3130 pb byt $10,$20 3140 fr byt 0 3150 st byt 0 3160 ro byt 0 3170 ir4 dec ud ! update delay 3180 bne ire 3190 lda #10 3200 sta ud 3210 lda $dc0b 3220 and #$7f 3230 jsr dsp ! decimal split 3240 sta $41b 3250 sty $41c ! display clock 3260 lda $dc0a 3270 jsr dsp 3280 sta $41e 3290 sty $41f 3300 lda $dc09 3310 jsr dsp 3320 sta $421 3330 sty $422 3340 lda $dc08 3350 ! flash & rest 3360 jmp ire 3370 dsp pha ! decimal split 3380 and #15 3390 clc 3400 adc #$30 3410 tay 3420 pla 3430 lsr a 3440 lsr a 3450 lsr a 3460 lsr a 3470 clc 3480 adc #$30 3490 rts 3500 irt byt 0 3510 irc byt 0,0 3520 irl byt 55,239 3530 wcs byt 16,16 3540 ud byt 0 3550 main lda #<tl ! top line 3560 ldy #>tl 3570 jsr $ab1e 3580 ldy dtt ! get date 3590 jsr bdc 3600 jsr dsp 3610 sta $40f 3620 sty $410 3630 ldy dtt+2 ! get year 3640 jsr bdc 3650 jsr dsp 3660 sta $417 3670 sty $418 3680 lda #0 3690 ldx dtt+1 ! get month 3700 dex 3710 beq mn3 3720 clc 3730 mn2 adc #3 3740 dex 3750 bne mn2 3760 tax 3770 mn3 clc 3780 lda mon,x 3790 and #$bf 3800 sta $412 3810 lda mon+1,x 3820 and #$bf 3830 sta $413 3840 lda mon+2,x 3850 and #$bf 3860 sta $414 3870 ! 3880 ! the following is crucial 3890 ! 3900 lda #$81 3910 sta $dc0e 3920 ldx #255 3930 tax 3940 cbm sta $1800,x ! clear bam 3950 dex 3960 bne cbm 3970 lda #0 3980 jsr $ff90 ! turn off messages 3990 ldx #<bam 4000 ldy #>bam ! load page table 4010 lda #1 4020 jsr d(NULL) 4030 ldx #<index ! load main page 4040 ldy #>index ! p100 @ $800 4050 lda #1 4060 jsr d(NULL) 4070 lda #8 ! p100 --> $1000 4080 ldx #8 4090 ldy #$10 4100 jsr move 4110 jsr sach 4120 gk jsr $ffe4 4130 cmp #0 4140 bne gl 4150 sta ro 4160 jmp gk 4170 gl cmp #$20 ! reveal key? 4180 bne gk2 4190 lda #1 4200 sta ro ! reveal on 4210 lm lda $dc01 ! lock mode 4220 and #$10 4230 beq lm 4240 jmp gk 4250 gk2 cmp #136 ! cancel? 4260 bne chl 4270 jmp ent ! end 64-tel 4280 chl cmp #80 ! p' pages available 4290 bne chk 4300 jsr dp ! display pages 4310 jmp gk 4320 chk cmp #133 ! f1 ? 4330 bne ch2 4340 jsr stl ! save top line 4350 jsr edit ! to editor 4360 jsr rtl ! restore 4370 jmp gk 4380 ch2 cmp #$31 ! '1' ? 4390 bne gk 4400 ldx $7eb 4410 stx cp ! current page 4420 jsr f7 4430 ldx $7eb 4440 cpx cp 4450 beq gk ! select same page 4460 cpx #100 4470 beq ind 4480 lda $1800,x ! page exist ? 4490 bne ch3 4500 ind lda #8 4510 ldx #$10 4520 ldy #$08 4530 jsr move 4540 jsr sach ! scn & col handler 4550 jmp gk 4560 ch3 lda #0 4570 sta $7ec 4580 ldx #$eb 4590 ldy #7 4600 lda #1 4610 jsr d(NULL) 4620 jsr sach 4630 jmp gk 4640 dp jsr stl 4650 jsr $e544 ! display pages 4660 lda $7e9 ! store f/r mode 4670 sta dtp+1 4680 lda #0 ! set reveal mode 4690 sta $7e9 4700 lda #19 ! home 4710 jsr $e716 4720 lda #17 4730 jsr $e716 4740 ldx #100 4750 dpl stx dtp 4760 lda $1800,x 4770 beq dpl2 4780 lda #0 4790 jsr $bdcd 4800 lda #32 4810 jsr $e716 4820 dpl2 ldx dtp 4830 inx 4840 cpx #200 ! reached page 200? 4850 bne dpl 4860 dpl3 jsr $ffe4 4870 cmp #0 ! wait for key 4880 beq dpl3 4890 lda dtp+1 4900 sta $7e9 4910 jmp sach+3 4920 stl ldx #$27 4930 st2 lda $400,x 4940 sta stt,x 4950 lda $d800,x ! save table 4960 sta ctt,x 4970 dex 4980 bpl st2 4990 rts 5000 dtp byt 0,0 5010 stt byt " " 5020 ctt byt " " 5030 rtl ldx #$27 5040 rt2 lda stt,x 5050 sta $400,x 5060 lda #$60 5070 sta $7c0,x 5080 lda ctt,x 5090 sta $d800,x 5100 dex 5110 bpl rt2 5120 rts 5130 sach jsr stl 5140 lda #4 5150 ldx #8 5160 ldy #4 5170 jsr move ! copy --> screen 5180 lda #4 5190 ldx #12 5200 ldy #$d8 5210 jsr move ! colour --> rom 5220 lda #4 5230 sta sss+2 5240 lda #12 5250 sta scc+2 5260 ldy #$28 5270 scc lda $8000,y 5280 and #$80 5290 beq sch2 5300 lda #$60 5310 sss sta $0400,y 5320 sch2 iny 5330 beq ipp 5340 cpy #$e8 5350 beq sch3 5360 jmp scc 5370 ipp inc scc+2 ! inc. pointers 5380 inc sss+2 5390 jmp scc 5400 sch3 lda sss+2 5410 cmp #7 5420 bne scc 5430 lda $be8 5440 sta irc+1 5450 lda $7ea 5460 jsr tlc ! set case 5470 jmp rtl 5480 ! 5490 ! this section is the page 5500 ! editor program. later on it 5510 ! will be added to the main code 5520 ! 5530 ! 5540 edit lda #19 !home 5550 jsr $e716 5560 lda #17 5570 jsr $e716 5580 lda #0 5590 sta $7e9 ! auto reveal mode 5600 sta $7e8 ! black screen 5610 sta $7ea ! lowercase 5620 jsr tlc ! to lowercase 5630 ed1 lda 214 5640 bne ed2 ! cursor on top line? 5650 lda #17 5660 jmp ed3 5670 ed2 sec 5680 cmp #24 5690 bcc ed4 5700 lda #145 5710 ed3 jsr $e716 5720 ed4 ldy $d3 5730 lda ($d1),y 5740 eor #$80 5750 sta ($d1),y 5760 ed4t jsr $ffe4 ! get chars 5770 cmp #0 5780 bne ed4s 5790 ldx #1 5800 lme lda $dc01 ! lock mode 5810 cmp #223 5820 bne lmo 5830 stx ro 5840 jmp lme 5850 lmo dex 5860 stx ro 5870 jmp ed4t 5880 ed4s pha 5890 ldy $d3 5900 lda ($d1),y 5910 eor #$80 5920 sta ($d1),y 5930 pla 5940 cmp #133 ! f1 ? 5950 bpl ed6 5960 ed5 jsr $e716 5970 jmp ed1 5980 ed6 cmp #141 ! f8 ? 5990 bpl ed5 6000 sec 6010 sbc #133 6020 asl a 6030 tax 6040 jsr fm ! function message 6050 lda dvt,x ! dispatch vector 6060 ldy dvt+1,x ! table 6070 sta ed7+1 6080 sty ed7+2 6090 ed7 jsr $8000 6100 nop 6110 jmp ed1 6120 fm lda mvt,x ! message vector 6130 sta pku+1 ! pick up char. 6140 lda mvt+1,x 6150 sta pku+2 6160 ldy #0 6170 pku lda $8000,y 6180 beq fme ! end 6190 cmp #$40 6200 bmi pk2 6210 sec 6220 sbc #$40 6230 pk2 sta $7c0,y 6240 lda #4 6250 sta $dbc0,y 6260 iny 6270 jmp pku 6280 fme rts 6290 mvt wor x1,x3,x5,x7,x2,x4,x6,x8 6300 x1 byt "return to 64-tel ",0 6310 x2 byt "change screen colour ",0 6320 x3 byt "toggle upper/lowercase ",0 6330 x4 byt "removing page from disk ",0 6340 x5 byt "toggle flash/reveal ",0 6350 x6 byt "saving page to disk ",0 6360 x7 byt "new page number ",0 6370 x8 byt "screen copied to ram ",0 6380 dvt wor f1,f3,f5,f7,f2,f4,f6,f8 6390 jmp ed1 ! checks later 6400 ! 6410 ! move blocks of memory 6420 ! 6430 move cmp #0 6440 bne mv1 6450 rts 6460 mv1 stx mv2+2 6470 sty mv2+5 6480 tax 6490 ldy #0 6500 mv2 lda $8000,y 6510 sta $8000,y 6520 iny 6530 bne mv2 6540 inc mv2+2 6550 inc mv2+5 6560 dex 6570 bne mv2 6580 rts 6590 ! 6600 ! function key routines 6610 ! 6620 f1 pla ! return to 64-tel 6630 pla 6640 rts 6650 f2 inc irc+1 ! colour change 6660 lda irc+1 6670 sta $7e8 6680 rts 6690 f3 lda $7ea ! change case 6700 eor #1 6710 sta $7ea 6720 tlc tax 6730 lda bc,x 6740 jmp $e716 6750 bc byt 14,142 6760 f5 lda $7e9 ! flash/reveal mode 6770 eor #1 6780 sta $7e9 6790 rts 6800 f7 lda #$60 ! new page no. 6810 sta $402 6820 sta $403 6830 lda #$31 6840 sta $401 6850 jsr gend 6860 sta ten 6870 clc 6880 adc #$30 6890 sta $402 6900 jsr gend 6910 sta un 6920 clc 6930 adc #$30 6940 sta $403 6950 jsr evn 6960 clc 6970 adc #100 6980 sta $7eb 6990 rts 7000 f8 lda #4 ! scrn --> copy 7010 ldx #4 7020 ldy #$08 7030 jmp move 7040 f6 jsr f4 7050 ldx #4 7060 f6e lda $7e8,x ! essentials 7070 sta $be8,x 7080 dex 7090 bpl f6e 7100 lda #4 ! save page to disk 7110 sta f6s+2 7120 lda #8 7130 sta f6c+2 7140 lda #$0c 7150 sta f6t+2 7160 lda #$d8 7170 sta f6r+2 7180 ldy #0 7190 f6s lda $8000,y ! get colour 7200 f6c cmp $8000,y ! any match 7210 php 7220 f6r lda $8000,y 7230 and #15 7240 plp 7250 beq f6t 7260 ora #$80 7270 f6t sta $8000,y 7280 iny 7290 bne f6s 7300 inc f6s+2 7310 inc f6c+2 7320 inc f6t+2 7330 inc f6r+2 7340 lda f6s+2 7350 cmp #8 7360 bne f6s 7370 tax 7380 lda #1 7390 ldy #255 7400 jsr $ffba 7410 ldx $beb 7420 stx dnam+2 7430 ldx #<dnam 7440 ldy #>dnam 7450 lda #3 7460 jsr $ffbd 7470 ldx #$f5 7480 ldy #$0f 7490 lda #0 7500 sta $fb 7510 lda #$08 7520 sta $fc 7530 lda #$fb 7540 jsr $ffd8 ! save $800 - $1000 7550 ldx $beb 7560 lda #$ff 7570 sta $1800,x ! this page filled 7580 lda $7eb ! new index page ? 7590 cmp #100 7600 bne nni ! no 7610 lda #8 7620 ldx #$8 7630 ldy #$10 7640 jsr move 7650 nni rts 7660 dnam byt "@:x" 7670 f4 ldx $7eb ! scratch a 64-tel 7680 ! page 7690 lda $1800,x ! does page exist? 7700 bne f41 7710 rts 7720 f41 lda #0 7730 sta $1800,x ! page now free 7740 stx com+3 7750 lda #4 7760 ldy #>com 7770 ldx #<com 7780 jsr $ffbd ! "@s0:x" 7790 lda #15 7800 ldx #8 7810 ldy #15 7820 jsr $ffba ! setlfs 7830 jsr $ffc0 ! send disk command 7840 lda #15 7850 jsr $ffc3 ! close file 7860 rts 7870 com byt "s0:a" 7880 d(NULL) jsr $ffbd ! disk load 7890 ldx #8 7900 lda #1 7910 ldy #255 7920 jsr $ffba 7930 lda #0 7940 jmp $ffd5 7950 ent ldx #8 ! end of 64-tel 7960 lda #1 7970 ldy #255 7980 jsr $ffba 7990 ldx #66 8000 stx dnam+2 8010 ldx #<dnam 8020 ldy #>dnam 8030 lda #3 8040 jsr $ffbd 8050 ldx #$f5 8060 ldy #$18 8070 lda #0 8080 sta $fb 8090 lda #$18 8100 sta $fc 8110 lda #$fb 8120 jsr $ffd8 ! save $1800 - $1900 8130 lda #0 8140 sta $7e9 8150 jmp $e544